home *** CD-ROM | disk | FTP | other *** search
- /* PIE.TM : A PROLOG INFERENCE ENGINE AND TRUTH MAINTENANCE */
- /* SYSTEM */
-
-
-
- /* This file contains most of the fundamental predicates necessary */
- /* for doing truth maintenance. PIE uses the prolog interpreter as */
- /* an input parser by declaring most of the PIE syntax as goals. */
- /* Prior to execution the operators must be declared.This is */
- /* simplified by using the redirect feature of ADA Prolog with the */
- /* command line: 'prolog kops' */
- /* The system is not yet complete and several extentions are */
- /* planned, many of which have already been implemented but */
- /* remain to be integrated with this particular piece of code. */
- /* Examples of planned extentions follow: one-directional rules, */
- /* a non-rule based inference based on mathematical set covering, */
- /* confidence factors, and more refined techniques for displaying */
- /* and editing a knowledge base. At the moment it is useful to know*/
- /* or have a copy of the underlying representation. There is not */
- /* a lot of code here and it has not been thoroughly tested, but it*/
- /* is quite powerful and flexible. */
-
-
- /* Sets 'X implies Y' up as a goal. NOTE: In order for the input to*/
- /* be parsed properly antecedents and consequents must be given as */
- /* lists, e.g. '[X is a male,X is a human] implies [X is a man]'. */
- /* Consequents may themselves be rule declarations. The rules */
- /* are bi-directional and may contain Prolog goals as elements */
- /* of the antecedent or consequent lists. To force forward */
- /* chaining 'fc' may be made a member of the antecedent or */
- /* consequent lists. */
-
- X implies Y :-
- assert_r(X implies Y).
-
-
-
- /* Cycles through all the forward chaining rules to find out if */
- /* the most recent assertion will cause any to fire. The */
- /* efficiency of this function can be increased dramatically by */
- /* copying the original rule to a 'non-conflict' stack and */
- /* effacing those conditions that have already been met. This */
- /* will result in ever shorter antecednt lists for the rules. */
-
-
- fc:-
- clause(rule(N,D,Y implies Z,C),true),
- given_mem(Y),
- check_mult_con(N,Z),
- fail.
- fc.
-
- /* Checks to see if an antecedent that is part of a list exists */
- /* as a given in the kb. */
-
- given_mem([]).
- given_mem([Y|Z]):-
- (Y;fact(N,D,Y,C)),
- given_mem(Z),!.
-
- /* Reads through a list of consequents and passes them on to */
- /* the infer function only if they do not already exist in the */
- /* kb. This should be enhanced so that confidence factors can */
- /* be incremented. */
-
- check_mult_con(N,[]).
- check_mult_con(N,[X|Y]):-
- infer(N,X),
- check_mult_con(N,Y),!.
-
-
-
- /*The PIE assert adds facts to the knowledge base. While doing */
- /*so it checks to make sure that no conflicting facts exist. If */
- /*conflicting facts do exist their identity is displayed. */
- /*Planned extentions include backward truth maintenance, wherein */
- /*the inferences that led to both of the conflicting facts will */
- /*be evaluated for confidence and 'distance' from input. */
- /* A typical assertion made by the user might look like: */
- /* assert([bill is a man]). */
- /* If the assert(X) is followed by an 'fc', forward chaining */
- /* will occur for the entire system. */
-
- /* This is a special instance of the PIE assert. It allows new */
- /* relations to be declared in the form of operators. Asserting */
- /* 'loves is a relation' will allow subsequent use of 'loves' as*/
- /* an infix operator in antecedents or consequents of rules, */
- /* e.g. [X loves Y] implies [Y loves X]. */
-
- assert([]).
- assert([X is a Rel|Y]) :-
- nonvar(R),
- R=relation,
- gensym(rel,N),
- asserta(relation(N,_)),
- op(10,xfx,X),
- assert(Y).
- assert([X|Y]):-
- fact(Number,Dependence,X,Confidence),
- assert(Y).
- assert([X|Y]):-
- fact(Number,Dependence,not(X),Confidence),!,
- print('Sorry, in conflict with existing information.'),nl,
- print('Dependency for ',Number),nl,
- prt_dependency(Number),
- assert(Y).
- assert([not(X)|Y]):-
- fact(Number,Dependence,X,Confidence),!,
- print('Sorry, in conflict with existing information.'),nl,
- print('Dependency for ',Number),nl,
- prt_dependency(Number),
- assert(Y).
-
- assert([not(X)|Y]):-
- check_word(X,_),
- functor(X,F,N),
- (atom(X);N>0),
- gensym(f,Number),
- assertz(fact(Number,input,not(X),Conf)),
- print('Inserted: ',Number,' not',X),nl,!,
- assert(Y).
- assert([X|Y]):-
- check_word(X,_),
- functor(X,F,N),!,
- N>0,
- gensym(f,Number),
- assertz(fact(Number,input,X,C)),
- print('Inserted: ',Number,' ',X),nl,!,
- assert(Y).
-
-
- /* Specifically designed for adding rules to the knowledge base */
-
- assert_r(not(X)):-
- check_word(X,Y),
- functor(X,F,N),
- F=implies,
- gensym(r,Number),
- assertz(rule(Number,input,not(X),Conf)),!,
- print('Inserted: ',Number,' not',X),nl.
- assert_r(X):-
- check_word(X,Y),
- functor(X,implies,N),
- gensym(r,Number),
- assertz(rule(Number,input,X,Conf)),!,
- print('Inserted: ',Number,' ',X),nl.
-
- /* The 'infer' clause allows assertions to be made as a result of */
- /* inference. It is similar to 'assert', but allows the passing */
- /* of a dependency bound to 'N'. */
-
- infer(N,not(X)):-
- fact(Num,Dependence,X,Confidence),!,
- print('Sorry, in conflict with existing information.'),nl,
- print('Dependency of existing info ',Num,' ',X),nl,
- prt_dependency(Num),
- print('Dependence of new conflicting info not',X),nl,
- prt_dependency(N).
- infer(N,X):-
- fact(Num,Dependence,not(X),Confidence),!,
- print('Sorry, in conflict with existing information.'),nl,
- print('Dependency of existing info ',Num,'not',X),nl,
- prt_dependency(Num),
- print('Dependence of new conflicting info ',X),nl,
- prt_dependency(N).
- infer(N,X):-
- (X;fact(_,_,X,_);rule(_,_,X,_)).
- infer(N,X):-
- X='implies'(_,_),
- gensym(r,Number),
- assertz(rule(Number,N,X,Conf)),
- print('Inserted: ',Number,' ',X),nl,!.
- infer(N,X):-
- (atom(X);true),
- gensym(f,Number),
- assertz(fact(Number,N,X,Conf)),
- print('Inserted: ',Number,' ',X),nl,!.
-
- /* Builds a vocabulary for the system and ensures that typographical errors */
- /* are not introduced. A typographical error might result in what would */
- /* to be two different values for an attribute or two different attributes */
- /* for an object. */
-
- check_word(X,_):-
- var(X).
- check_word(X,_):-
- word(X).
- check_word(X,Y):-
- X= '`s'(A,B),
- check_word(A,A1),
- check_word(B,B1).
- check_word(X,Y):-
- X= 'is a'(A,B),
- check_word(A,A1),
- check_word(B,B1),
- setval(B1,A1).
- check_word(X,Y):-
- X=F(A,B),
- check_word(A,A1),
- check_word(B,B1),
- setval(A1,B1).
- check_word([X|Tail],_):- /* Allows the use of ';'and lists within a list */
- check_word(X,_),
- (Tail =[];check_word(Tail,_)).
- check_word(X,Y):-
- print('Is ',X,' a correct value? y/n: '),
- ((ratom(y),X=Y);(replace_value(Y))).
- replace_value(Y):-
- print('Please, type in correct value: '),
- ratom(Y).
- setval(A,B):-
- nonvar(A),
- nonvar(B),
- asserta(legval(A,B)).
- setval(A,B):-
- nonvar(A),
- asserta(word(A)),
- fail.
- setval(A,B):-
- nonvar(B),
- asserta(word(B)),
- fail.
- setval(_,_).
-
- /* A simple recursive function that will print out the rule */
- /* numbers on which a fact or rule depends. Extensions to this */
- /* will allow for viewing in various modes and editing. */
-
- prt_dependency(input).
- prt_dependency(N):-
- (fact(N,input,_,_);rule(N,input,_,_)),
- print('input').
- prt_dependency(N):-
- (fact(N,D,_,_);rule(N,D,_,_)),
- (fact(D,D1,X,Conf);rule(D,D1,X,Conf)),
- write(D),tab(2),write(X),tab(2),write(Conf),nl,
- prt_dependency(D1).
-
- rule(X):-
- rule(X,Dep,Body,Conf),
- print(X,' ',Dep,' ',Body,' ',Conf),nl.
- rules:-
- clause(rule(A,B,C,D),true),
- print(A,' ',B,' ',C,' ',D),nl,
- fail.
- rules.
-
- fact(X):-
- fact(X,Dep,Body,Conf),
- print(X,' ',Dep,' ',Body,' ',Conf),nl.
- facts:-
- clause(fact(Num,Dep,Body,Conf),true),
- print(Num,' ',Dep,' ',Body,' ',Conf),nl,
- fail.
- facts.
-
-
-
- /* Allows removal of rules or facts by reference to their gensym */
- /* index. This could easily be enhanced by allowing instantiation */
- /* through explicitly typing out the item to be removed. */
- /* Automatically removes assertions that depend on the retracted */
- /* item. */
-
- remove(N):-
- retract(rule(N,D,X implies Y,C)),
- print('Removed: ',N,' ',X,'implies',Y),nl,
- remove_con(N,Y).
- remove(N):-
- retract(fact(N,D,X,C)),
- clause(rule(N1,_,Y implies Z,_),true),
- print('Removed: ',N,' ',X),nl,
- mem(X,Y),
- remove_con(N1,Z),
- fail.
-
- /* 'Remove' will automatically forward chain in order re-infer */
- /* things that may be obtained through a different route than */
- /* that affected by the retraction process. This is necessary */
- /* because not all facts are taken advantage of in inferencing. */
- /* That is to say, if a fact already exists 'infer' and 'assert'*/
- /* will not add them redundantly to the kb. This will change */
- /* with the addition of confidence factors. */
-
- remove(N):-
- fc.
-
-
- /* Exhaustively checks facts in the kb and removes them if they */
- /* depend on another item removed. NOTE: 'N=D' is part of a */
- /* disjunction, if it fails the fact will be reinserted in the */
- /* kb. At the moment this does not take advantage of the ADA */
- /* Prolog indexing capability, but it should in a dedicated */
- /* ADA application. */
-
- remove_con(N,[]).
- remove_con(N,[X|Y]):-
- retract(fact(N1,N,X,C)),
- print('Removed: ',N1,' ',X),nl,
- remove_con(Y).
- remove_con([X|Y]):-
- remove_con(Y).
-
-
-
-
- /* Activates backward chaining. A complex function, the first */
- /* two clauses REQUIRE a list to function properly, but valid- */
- /* ation is not done. This is required by the inference */
- /* mechanism. Its effect is to ensure that inheritance is not */
- /* carried over to uninstantiated objects. */
-
- obtain([]).
- obtain(X):-
- X =[Y|Z],!,
- obtain_1(Y),
- obtain(Z).
- obtain_1(X):-
- X.
- obtain_1(X):-
- clause(fact(N,D,X,C),true).
-
- obtain_1(X):-
- clause(rule(N,D,Y implies Z,C),true),
- nl,
- not(chk(N)), /* Prevents double pattern match. */
- mem(X,Z),
- asserta(chk(N)),
- obtain(Y). /* Recursive check for ant as a con.*/
- obtain_1(F(A,B)):-
- X=F(A,F1(C,D)),
- nonvar(F1),!,
- print(A,' ',F,' ',C,' ',F1,' ',D),nl,
- obtain_1a(F(A,F1(C,D))),
- assert([F(A,F1(C,D))]),
- refresh. /* Removes 'chk' tag. */
- obtain_1(F(A,B)):-
- print(A,' ',F,' ',B),nl,
- obtain_1b(F(A,B)),
- assert([F(A,B)]),
- refresh.
- obtain_1a(F(A,F1(B,C))):-
- print('Please,fill in the blanks:'),nl,
- get_val(A,_),
- print(A,' ',F,' '),
- get_val(B,A),
- print(B,' ',F1,' '),
- get_val(C,B).
- obtain_1b(F(A,B)):-
- print('Please,fill in the blanks:'),nl,
- get_val(A,_),
- print(A,' ',F,' '),
- get_val(B,A).
- get_val(X,_):-
- nonvar(X).
- get_val(X,Y):-
- listvals(Y),
- r_val(X,Y).
- r_val(X,Y):-
- ratom(Z),
- /* legval(Y,Z), */
- Z=X.
-
-
- /* Refreshes rules */
- refresh:-
- retract(chk(_)),
- fail.
- refresh.
-
-
- listvals(_). /* Temporarily axiomatic */
- listvals(X):-
- clause(legval(X,Y),true),
- print(Y),nl,
- fail.
- listvals(_).
-
-
- /* Standard Prolog append. */
-
- append([],X,X).
- append([A|B],C,[A|D]):-
- append(B,C,D).
-
-
- /* Standard Prolog member. */
-
- mem(X,[X|_]).
- mem(X,[Y|Z]):-
- mem(X,Z).
-
- /* Standard Prolog gensym. */
-
- gensym( Root, Atom ) :-
- get_num( Root, Num ),
- name( Root, Name1 ),
- integer_name( Num, Name2 ),
- append( Name1, Name2, Name ),
- name( Atom, Name ).
-
- get_num( Root, Num ) :-
- retract( current_num( Root, Num1 )), !,
- Num is Num1 + 1,
- asserta( current_num( Root, Num)).
-
- get_num( Root, 1 ) :- asserta( current_num( Root, 1 )).
-
- integer_name( Int, List ) :- integer_name( Int, [], List ).
- integer_name( I, Sofar, [C|Sofar] ) :-
- I < 10, !, C is I + 48.
- integer_name( I, Sofar, List ) :-
- Tophalf is I/10,
- Bothalf is I mod 10,
- C is Bothalf + 48,
- integer_name( Tophalf, [C|Sofar], List ).
-
-
- append( [], L, L ).
- append( [Z|L1], L2, [Z|L3] ) :- append( L1, L2, L3 ).
-
-